home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Extra 1996 #2 / Amiga Plus CD - 1996 - No. 2 Extra.iso / clarissa1_1-demo / macros / colorc.clssa < prev    next >
Text File  |  1995-01-26  |  4KB  |  175 lines
  1. /***********************************************************************
  2.   GADGET: "'ColorCycle'" "6" AUTO TYP: "?"
  3.  
  4.   $DAT >>ColorC.clssa<<       05.10.1992 - (C) ProDAD Holger Burkarth
  5.                               20.01.1995 - (C) ProDAD Michael Christoph
  6. ************************************************************************/
  7.  
  8. Options Results
  9. Address clariSSA
  10.  
  11.   FailAt 10
  12.   AltFail=RESULT
  13.  
  14.   GetArea
  15.   PARSE VAR RESULT . "FROM" von "TO" bis .
  16.   von=Strip(von)
  17.  
  18.   Anzahl=bis-von
  19.   IF Anzahl>1 THEN DO
  20.  
  21.     DO FOREVER
  22.       MSRequester "TITLE '*** ColorCycle ***'",
  23.                         "''",
  24.                         "'Wählen Sie die Effektart aus.'",
  25.                   "PTEXT 'Zyklische Farbrotation'",
  26.                         "'Gespiegelte Farbrotation (Kontrast)'",
  27.                         "'Gespiegelte Farbrotation '"
  28.       IF RC~=0 THEN LEAVE
  29.       Art=RESULT
  30.  
  31.       COLRequest "FROM 0 TO 1 TITLE '*** ColorCycle ***''''Farbbereich bestimmen.'"
  32.       IF RC~=0 THEN LEAVE
  33.       ListeG=RESULT
  34.       RevListe=ListeG
  35.       PARSE VAR ListeG SFarbe ListeG
  36.       EFarbe=SFarbe
  37.       DO UNTIL ListeG=""
  38.         PARSE VAR ListeG EFarbe ListeG
  39.       END
  40.       IF EFarbe="" THEN EFarbe=0
  41.  
  42.       IF SFarbe = EFarbe THEN DO
  43.         Message "'Der Farbbereich muß sich''über min. 2 Farben erstrecken.'"
  44.         LEAVE
  45.       END
  46.  
  47.       INTRequest "'*** ColorCycle ***''''Anzahl der zu erzeugenden'",
  48.                  "'Farbrotationen im Animationsbereich.'",
  49.                  "'(1 Zyklus == "EFarbe-SFarbe")'"Anzahl
  50.       IF RC~=0 THEN LEAVE
  51.       Rot=RESULT
  52.       IF Rot<1 THEN DO
  53.         Message "'Eingegebener Wert ist''nicht zulässig!'"
  54.         LEAVE
  55.       END
  56.  
  57.       IF Art=2 THEN DO
  58.        RevListe=RollRevListe(TRUNC((EFarbe+SFarbe)/2),SFarbe,EFarbe)
  59.       END
  60.       ELSE IF Art=3 THEN DO
  61.        RevListe=RollRevListe2(SFarbe,EFarbe)
  62.       END
  63.  
  64.  
  65.       BOOLRequest "'Animationsfarben ändern?''Anim: Master''<< von "von" bis "bis" >>'"
  66.       IF RC~=0 | RESULT="NO" THEN LEAVE
  67.  
  68.       RequestStatus OFF
  69.       ViewFrame COPS von
  70.       GetColor RevListe
  71.       ListeC=RESULT
  72.       Pos=1
  73.       M=0
  74.       DO UNTIL von>bis
  75.         n=TRUNC(Pos*Rot/Anzahl+0.5)
  76.         ListeG=RollListe(n,SFarbe,EFarbe)
  77.  
  78.         Liste=""
  79.         DO UNTIL ListeC=""
  80.           PARSE VAR ListeG n ListeG
  81.           PARSE VAR ListeC x r g b ListeC
  82.           Liste=Liste n r g b
  83.         END
  84.  
  85.         SetColor Liste
  86.         Record COPS
  87.         IF RC~=0 THEN LEAVE
  88.         von=von+1
  89.         Pos=Pos+1
  90.         ViewFrame COPS von
  91.         IF RC~=0 THEN LEAVE
  92.         GetColor RevListe
  93.         ListeC=RESULT
  94.       END
  95.       RequestStatus ON
  96.  
  97.       LEAVE
  98.     END
  99.   END
  100.   ELSE Message "'Für einen ColorCycle müssen''min. 2 Frames ausgewählt werden.'"
  101.  
  102.   FailAt AltFail
  103. exit
  104.  
  105.  
  106.  
  107. RollListe: procedure
  108. DO
  109.   ARG n,Start,Ende
  110.  
  111.   x=Start+n
  112.   n=Start
  113.   Liste=""
  114.   DO UNTIL n>Ende
  115.     x=((x-Start+1) // (Ende-Start+1)) + Start
  116.     Liste=Liste x
  117.     n=n+1
  118.   END
  119.  
  120.   RETURN (Liste)
  121. END
  122.  
  123.  
  124.  
  125. RollRevListe: procedure
  126. DO
  127.   ARG n,Start,Ende
  128.  
  129.   Liste=""
  130.   l=Start - n
  131.   x=Start
  132.   ad=1
  133.   DO UNTIL x > Ende
  134.     f=Start+l
  135.     IF f > Ende THEN  f=(f-Start) - (Ende-Start) + Start
  136.     IF f < Start THEN f=(Ende-Start) + (f-Start) + Start + 1
  137.     Liste=Liste f
  138.  
  139.     if l=0 THEN ad=-1
  140.     l=l+ad
  141.     x=x+1
  142.   END
  143.  
  144.   RETURN (Liste)
  145. END
  146.  
  147.  
  148.  
  149.  
  150. RollRevListe2: procedure
  151. DO
  152.   ARG Start,Ende
  153.  
  154.   Liste=""
  155.   n=Ende-Start+1
  156.   l=Start
  157.  
  158.   DO UNTIL l > Ende
  159.     Liste=Liste l
  160.     l=l+2
  161.     n=n-1
  162.   END
  163.  
  164.   IF l-2 = Ende THEN l=l-3
  165.   ELSE               l=l-1
  166.  
  167.   DO UNTIL n<=0
  168.     Liste=Liste l
  169.     l=l-2
  170.     n=n-1
  171.   END
  172.  
  173.   RETURN (Liste)
  174. END
  175.